Exploratory Analysis of Demographic Characteristics Where Facilities are Located
# needed packages
library(tidyverse)
# to retrieve census data
library(censusapi)
# to read boundaries file
library(sf)
# to create tables
library(kableExtra)# read prison boundaries file from Homeland Infrastructure Foundation-Level Data Platform
# downloaded in geodatabase form and unzipped, read as sf object
# link: https://hifld-geoplatform.opendata.arcgis.com/datasets/geoplatform::prison-boundaries/about
prison_boundaries <- st_read("./1075f3ca-0050-4264-82e2-079a2daf2ec5.gdb", quiet = TRUE)
# read results that contain block assignment for each facility saved in csv
prison_boundaries_blocks <- read_csv("./data/prison_blocks.csv")
# for prison boundaries file, get list of all state county combinations represented, including the
# codes for the corresponding states and counties
# resulting data frame has 4 columns -->
# COUNTYFIPS -- 5 digit code consisting of state code and county code
# STATE -- 2 chracter digit state abbreviation
# STATEFIPS -- 2 digit state FIPS
# COUNTYCODE -- 3 digit county code
state_county_list <- st_drop_geometry(prison_boundaries) %>%
group_by(COUNTYFIPS, STATE) %>%
summarize() %>%
select( COUNTYFIPS, STATE) %>%
mutate(STATE = as.character(STATE),
COUNTYFIPS = as.character(COUNTYFIPS),
STATEFIPS = substr(COUNTYFIPS, 1, 2),
COUNTYCODE= substr(COUNTYFIPS,
nchar(COUNTYFIPS) - 2,
nchar(COUNTYFIPS)))
# remove the NOT AVAILABLE entry
state_county_list_filtered <- state_county_list[state_county_list$COUNTYFIPS != "NOT AVAILABLE",]
# get all state fips codes in prison boundaries data
state_codes <- state_county_list_filtered %>%
group_by(STATEFIPS) %>%
summarize() %>%
pull(STATEFIPS)Analysis at the Block Group Level
# can use this function to see what variables are available for the given dataset
# listCensusMetadata(name = "pdb/blockgroup", vintage = 2021, type = "variables", group = NULL)
# get census data for the variables listed at the blockgroup level; block level not available
get_census_data_safe <- function(state_code) {
region_for_state = paste0("state:", state_code, "+county:*+tract:*")
result <- tryCatch(
{
getCensus(name = "pdb/blockgroup",
vintage = 2021,
key = "fbbc8b0d3e53089da7cabc380628d6d46ae00444",
vars = c("Block_group",
"County",
"URBANIZED_AREA_POP_CEN_2010",
"Tot_Population_CEN_2010",
"Tot_Population_ACS_15_19",
"Males_ACS_15_19",
"Females_ACS_15_19",
"Median_Age_ACS_15_19",
"Hispanic_ACS_15_19",
"NH_White_alone_ACS_15_19",
"NH_Blk_alone_ACS_15_19",
"NH_AIAN_alone_ACS_15_19",
"NH_Asian_alone_ACS_15_19",
"NH_NHOPI_alone_ACS_15_19",
"NH_SOR_alone_ACS_15_19",
"Pov_Univ_ACS_15_19",
"Prs_Blw_Pov_Lev_ACS_15_19",
"No_Health_Ins_ACS_15_19",
"Tot_Occp_Units_ACS_15_19",
"Aggregate_HH_INC_ACS_15_19",
"Med_HHD_Inc_BG_ACS_15_19",
"Tot_Prns_in_HHD_ACS_15_19",
"Renter_Occp_HU_ACS_15_19",
"Med_House_Value_BG_ACS_15_19",
"pct_ENG_VW_ACS_15_19",
"pct_URBANIZED_AREA_POP_CEN_2010",
"pct_RURAL_POP_CEN_2010",
"pct_Inst_GQ_CEN_2010",
"pct_Non_Inst_GQ_CEN_2010",
"pct_URBAN_CLUSTER_POP_CEN_2010",
"pct_PUB_ASST_INC_ACS_15_19"
),
regionin = region_for_state,
region = "block group:*")
} ,
error=function(e) {
return()
}
)
return(result)
}
# get block group level data for every state in state_codes - only run when making changes to the variables included in the function above
# blockgroup_level_data <- map_dfr(state_codes, ~get_census_data_safe(.x))
# remove of redundant columns
# blockgroup_level_data <- blockgroup_level_data %>%
# select(-Block_group, County)
# write_csv(blockgroup_level_data, "./data/blockgroup_level_data.csv")
blockgroup_level_data <- read_csv("./data/blockgroup_level_data.csv")
# get block group number, which is the first digit of the block number
prison_boundaries_blocks <- prison_boundaries_blocks %>%
mutate(block_group = as.numeric(substr(BLOCKCE10, 1,1)))
# join prison boundaries data to the census data
prison_boundaries_block_census <- left_join(prison_boundaries_blocks, blockgroup_level_data,
by = c("STATEFP10" = "state",
"COUNTYFP10" = "county",
"TRACTCE10" = "tract",
"block_group" = "block_group"))
# reorder TYPE and SECURELVL
prison_boundaries_block_census <- prison_boundaries_block_census %>%
mutate(TYPE = factor(TYPE,
levels = c("LOCAL", "COUNTY",
"STATE", "FEDERAL",
"MULTI", "NOT AVAILABLE")),
SECURELVL = factor(SECURELVL, levels = c("JUVENILE", "MINIMUM",
"MEDIUM", "MAXIMUM",
"CLOSE", "NOT AVAILABLE")))
# all variables in the dataset
all_vars <- prison_boundaries_block_census %>% colnames()Variable definitions are from the documentation for the 2021 Planning Database.
First, we can look at the distributions of the median age in block groups where facilities are located.
Note that we can look at these distributions by block group (where the frequency on the y-axis is the number of block groups) and by facility (where the frequency on the y-axis is the number of facilities). The difference in these approaches is due to the fact that some block groups contain multiple facilities, which we can see by running the line prison_boundaries_block_census %>% group_by(STATE, COUNTY, TRACTCE10, block_group) %>% summarize(n = n()) %>% filter(n > 1 ) %>% nrow(). This shows us that 987 block groups contain multiple facilities.
Distribution of Median Age
library(forcats)
#### FOR COMPARISON: distribution of median age for all block groups across the U.S.
blockgroup_level_data %>%
select(Median_Age_ACS_15_19) %>%
ggplot(aes(x = Median_Age_ACS_15_19 )) +
geom_histogram() +
geom_vline(aes(xintercept = median(Median_Age_ACS_15_19, na.rm = TRUE)), color = "darkred") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Median Age",
subtitle = "2015 – 2019 5-year ACS sample data ",
title = "Distribution of Median Age in Block Groups Across the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 10), limits = c(0, 100))# Distribution of Median Age in Block Groups Where Facilities are Located using Median_Age_ACS_15_19 variable
###### distribution of median age by block group
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10, block_group, Median_Age_ACS_15_19) %>%
summarize() %>%
select(Median_Age_ACS_15_19) %>%
ggplot(aes(x = Median_Age_ACS_15_19 )) +
geom_histogram() +
geom_vline(aes(xintercept = median(Median_Age_ACS_15_19, na.rm = TRUE)), color = "darkred") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Median Age",
subtitle = "Median of the Distribution Marked in Red\n2015 – 2019 5-year ACS sample data ",
title = "Distribution of Median Age in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 10), limits = c(0,100))###### tables for comparison
us <- blockgroup_level_data %>%
select(Median_Age_ACS_15_19) %>%
summarize(Mean = mean(Median_Age_ACS_15_19, na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
Median_Age_ACS_15_19) %>%
summarize() %>%
ungroup() %>%
summarize(Mean = mean(Median_Age_ACS_15_19, na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Median Age in Block Groups</b></span><br><i>Data from the 2015-2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 40.5 | 39.8 |
| Block Groups Where Facilities are Located | 39.2 | 38.4 |
# median age distribution faceted by facility type
##### by block group
## the grouping used here is to count a block group for a given facility type once within a facet
## block groups may appear more than once across facets though since a single block group may have a local and county facility, for example
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10, block_group, Median_Age_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
group_by(TYPE) %>%
mutate(Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
ungroup() %>%
ggplot(aes(x = Median_Age_ACS_15_19)) +
geom_histogram() +
geom_vline(aes(xintercept = Median), color = "darkred") +
facet_wrap(~TYPE, scales = "free_y") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Median Age",
subtitle = "Median of the Distribution Marked in Red\n2015 – 2019 5-year ACS sample data ",
title = "Distribution of Median Age in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5))### table by type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
Median_Age_ACS_15_19, TYPE) %>%
summarize() %>%
ungroup() %>%
group_by(TYPE) %>%
summarize(Mean = mean(Median_Age_ACS_15_19, na.rm = TRUE),
Mean = round(Mean, digits = 2),
Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Median Age in Block Groups Where Facilities are Located</b><br>by Facility Type</span><br><i>Data from the 2015-2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 37.14 | 36.50 |
| COUNTY | 39.30 | 38.35 |
| STATE | 39.20 | 38.50 |
| FEDERAL | 38.86 | 39.20 |
| MULTI | 35.99 | 34.30 |
| NOT AVAILABLE | 41.45 | 40.90 |
# median age distribution faceted by facility security level
##### by block group
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Median_Age_ACS_15_19,
SECURELVL) %>%
summarize() %>%
group_by(SECURELVL) %>%
mutate(Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
ungroup() %>%
ggplot(aes(x = Median_Age_ACS_15_19)) +
geom_histogram() +
geom_vline(aes(xintercept = Median), color = "darkred") +
facet_wrap(~SECURELVL, scales = "free_y") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Median Age",
subtitle = "2015 – 2019 5-year ACS sample data ",
title = "Distribution of Median Age in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5))# table by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
Median_Age_ACS_15_19, SECURELVL) %>%
summarize() %>%
ungroup() %>%
group_by(SECURELVL) %>%
summarize(Mean = mean(Median_Age_ACS_15_19, na.rm = TRUE),
Mean = round(Mean, digits = 2),
Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
rename(`Facility Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Median Age in Block Groups Where Facilities are Located</b><br>by Facility Security Level</span><br><i>Data from the 2015-2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 38.50 | 37.50 |
| MINIMUM | 39.24 | 38.80 |
| MEDIUM | 38.46 | 38.30 |
| MAXIMUM | 37.73 | 36.80 |
| CLOSE | 38.35 | 37.75 |
| NOT AVAILABLE | 39.56 | 38.80 |
#### MAKING PLOTS BY FACILITY, RATHER THAN BLOCK GROUP
#### FREQUENCY ON Y-AXIS REPRESENTS FACILITIES, SO SOME BLOCK GROUPS ARE COUNTED MULTIPLE TIMES
###### distribution of median age
prison_boundaries_block_census %>%
select(Median_Age_ACS_15_19) %>%
ggplot(aes(x = Median_Age_ACS_15_19 )) +
geom_histogram() +
geom_vline(aes(xintercept = median(Median_Age_ACS_15_19, na.rm = TRUE)),
color = "darkred") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Median Age",
subtitle = "Median of the Distribution Marked in Red\n2015 – 2019 5-year ACS sample data ",
title = "Distribution of Median Age in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5))
##### distribution of median age faceted by facility type
prison_boundaries_block_census %>%
group_by(TYPE) %>%
mutate(Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
select(Median_Age_ACS_15_19, TYPE, Median) %>%
mutate(TYPE = factor(TYPE, levels = c("LOCAL", "COUNTY",
"STATE", "FEDERAL",
"MULTI", "NOT AVAILABLE"))) %>%
ggplot(aes(x = Median_Age_ACS_15_19)) +
geom_histogram() +
geom_vline(aes(xintercept = Median), color = "darkred") +
facet_wrap(~TYPE, scales = "free_y") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Median Age",
subtitle = "Median of the Distribution Marked in Red\n2015 – 2019 5-year ACS sample data ",
title = "Distribution of Median Age in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5))
##### distribution of median age faceted by facility security level
prison_boundaries_block_census %>%
group_by(SECURELVL) %>%
mutate(Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
select(Median_Age_ACS_15_19, SECURELVL, Median) %>%
mutate(SECURELVL = factor(SECURELVL, levels = c("JUVENILE", "MINIMUM",
"MEDIUM", "MAXIMUM",
"CLOSE", "NOT AVAILABLE"))) %>%
ggplot(aes(x = Median_Age_ACS_15_19)) +
geom_histogram() +
geom_vline(aes(xintercept = Median), color = "darkred") +
facet_wrap(~SECURELVL, scales = "free_y") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Median Age",
subtitle = "2015 – 2019 5-year ACS sample data ",
title = "Distribution of Median Age in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5))Interpretation note on the faceted plots: for a value on the x-axis in a category, we would interpret the corresonding y-value as the number of block groups with that type (or security level) of facility with the specified median age given by the x-value.
Example: The number of block groups containing a federal facility where the median age was about 60 is about 2.
Distribution of the Percentage Urbanized
As defined in the documentation, the variable definitions are as follows:
*pct_URBANIZED_AREA_POP_CEN_2010: “percentage of the 2010 Census total population that lives in a densely settled area containing 50,000 or more people”
*pct_URBAN_CLUSTER_POP_CEN_2010: “percentage of the 2010 Census total population that lives in a densely settled area containing 2,500 to 49,999 people”
*pct_RURAL_POP_CEN_2010: “percentage of the 2010 Census total population that lives outside of an urbanized area or urban cluster”
library(scales)
#### FOR COMPARISON -- distribution of percentage urbanized across the full U.S.
blockgroup_level_data %>%
mutate(Median = median(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE)) %>%
select(pct_URBANIZED_AREA_POP_CEN_2010, Median, Mean) %>%
ggplot(aes(x = pct_URBANIZED_AREA_POP_CEN_2010 )) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Urbanized",
subtitle = "Mean in Blue, Median in Red\n2010 Census Data",
title = "Distribution of the Percentage Urbanized for Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_y_continuous(labels = comma)# distribution of percentage urbanized
# by block group
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_URBANIZED_AREA_POP_CEN_2010) %>%
summarize() %>%
ungroup() %>%
mutate(Median = median(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE)) %>%
select(pct_URBANIZED_AREA_POP_CEN_2010, Median, Mean) %>%
ggplot(aes(x = pct_URBANIZED_AREA_POP_CEN_2010 )) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Urbanized",
subtitle = "Mean in Blue, Median in Red\n2010 Census Data",
title = "Distribution of the Percentage Urbanized Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5))###### tables for comparison
us <- blockgroup_level_data %>%
select(pct_URBANIZED_AREA_POP_CEN_2010) %>%
summarize(Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_URBANIZED_AREA_POP_CEN_2010) %>%
summarize() %>%
ungroup() %>%
summarize(Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0(., "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Percentage Urbanized in Block Groups</b></span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 69% | 100% |
| Block Groups Where Facilities are Located | 33.7% | 0% |
# faceted by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_URBANIZED_AREA_POP_CEN_2010, TYPE) %>%
summarize(n=n()) %>%
ungroup() %>%
group_by(TYPE) %>%
mutate(Median = median(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_URBANIZED_AREA_POP_CEN_2010 )) +
geom_histogram() +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1) +
geom_vline(aes(xintercept = Mean),
color = "#718BCE",
size = 1) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Urbanized",
subtitle = "Mean in Blue, Median in Red\n2010 Census data ",
title = "Distribution of the Percentage Urbanized Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5),
strip.text = element_text(face = "bold")) ### table by type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_URBANIZED_AREA_POP_CEN_2010, TYPE) %>%
summarize() %>%
ungroup() %>%
group_by(TYPE) %>%
summarize(Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 2),
Median = median(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0(., "%"))) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Percentage Urbanized in Block Groups Where Facilities are Located</b><br>by Facility Type</span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 71% | 100% |
| COUNTY | 28.32% | 0% |
| STATE | 36.87% | 0% |
| FEDERAL | 42.97% | 0% |
| MULTI | 35.57% | 0% |
| NOT AVAILABLE | 38.48% | 0% |
# faceted by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_URBANIZED_AREA_POP_CEN_2010, SECURELVL) %>%
summarize(n=n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(Median = median(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_URBANIZED_AREA_POP_CEN_2010 )) +
geom_histogram() +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1) +
geom_vline(aes(xintercept = Mean),
color = "#718BCE",
size = 1) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Urbanized",
subtitle = "Mean in Blue, Median in Red\n2010 Census data ",
title = "Distribution of the Percentage Urbanized Where Facilities are Located\nFaceted by Facility Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5),
strip.text = element_text(face = "bold")) # table by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_URBANIZED_AREA_POP_CEN_2010, SECURELVL) %>%
summarize() %>%
ungroup() %>%
group_by(SECURELVL) %>%
summarize(Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 2),
Median = median(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0(., "%"))) %>%
rename(`Facility Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Urbanized in Block Groups Where Facilities are Located</b><br>by Facility Security Level</span><br><i>Data from the 2010 Census</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 52.68% | 75.235% |
| MINIMUM | 44.47% | 0% |
| MEDIUM | 27.53% | 0% |
| MAXIMUM | 49.72% | 52.08% |
| CLOSE | 25.1% | 0% |
| NOT AVAILABLE | 23.17% | 0% |
Distribution of Percentage Rural
pct_RURAL_POP_CEN_2010: “percentage of the 2010 Census total population that lives outside of an urbanized area or urban cluster”
#### FOR COMPARISON -- distribution of percentage rural across the U.S.
blockgroup_level_data %>%
mutate(Median = median(pct_RURAL_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_RURAL_POP_CEN_2010, na.rm = TRUE)) %>%
select(pct_RURAL_POP_CEN_2010, Median, Mean) %>%
ggplot(aes(x = pct_RURAL_POP_CEN_2010 )) +
geom_histogram() +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Rural",
subtitle = "Mean in Blue, Median in Red\n2010 Census Data",
title = "Distribution of the Percentage Rural in Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_y_continuous(labels = comma)# distribution of percentage rural
## y-axis represents block groups
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_RURAL_POP_CEN_2010) %>%
summarize(n=n()) %>%
ungroup() %>%
mutate(Median = median(pct_RURAL_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_RURAL_POP_CEN_2010, na.rm = TRUE)) %>%
select(pct_RURAL_POP_CEN_2010, Median, Mean) %>%
ggplot(aes(x = pct_RURAL_POP_CEN_2010 )) +
geom_histogram() +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Rural",
subtitle = "Mean in Blue, Median in Red\n2010 Census data ",
title = "Distribution of the Percentage Rural Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) ###### tables for comparison
us <- blockgroup_level_data %>%
select(pct_RURAL_POP_CEN_2010) %>%
summarize(Mean = mean(pct_RURAL_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(pct_RURAL_POP_CEN_2010,
na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_RURAL_POP_CEN_2010) %>%
summarize() %>%
ungroup() %>%
summarize(Mean = mean(pct_RURAL_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(pct_RURAL_POP_CEN_2010,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0(., "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Rural in Block Groups</b></span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 20.7% | 0% |
| Block Groups Where Facilities are Located | 35.4% | 8.87% |
# faceted by TYPE
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_RURAL_POP_CEN_2010, TYPE) %>%
summarize(n=n()) %>%
ungroup() %>%
group_by(TYPE) %>%
mutate(Median = median(pct_RURAL_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_RURAL_POP_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_RURAL_POP_CEN_2010 )) +
geom_histogram() +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Rural",
subtitle = "Mean in Blue, Median in Red\n2010 Census data ",
title = "Distribution of the Percentage Rural Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5),
strip.text = element_text(face = "bold")) ### table by type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_RURAL_POP_CEN_2010, TYPE) %>%
summarize() %>%
ungroup() %>%
group_by(TYPE) %>%
summarize(Mean = mean(pct_RURAL_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 2),
Median = median(pct_RURAL_POP_CEN_2010,
na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0(., "%"))) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Percentage Rural in Block Groups Where Facilities are Located</b><br>by Facility Type</span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 14.56% | 0% |
| COUNTY | 34.05% | 8.25% |
| STATE | 41.15% | 20.795% |
| FEDERAL | 29.7% | 4.985% |
| MULTI | 44.34% | 32.155% |
| NOT AVAILABLE | 45.39% | 33.495% |
# faceted by SECURELVL
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_RURAL_POP_CEN_2010, SECURELVL) %>%
summarize(n=n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(Median = median(pct_RURAL_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_RURAL_POP_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_RURAL_POP_CEN_2010 )) +
geom_histogram() +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Rural",
subtitle = "Mean in Blue, Median in Red\n2010 Census data ",
title = "Distribution of the Percentage Rural Where Facilities are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5),
strip.text = element_text(face = "bold")) ### table by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_RURAL_POP_CEN_2010, SECURELVL) %>%
summarize() %>%
ungroup() %>%
group_by(SECURELVL) %>%
summarize(Mean = mean(pct_RURAL_POP_CEN_2010,
na.rm = TRUE),
Mean = round(Mean, digits = 2),
Median = median(pct_RURAL_POP_CEN_2010,
na.rm = TRUE),
Median = round(Median, digits = 2)) %>%
mutate(across(c(Mean, Median), ~paste0(., "%"))) %>%
rename(`Facility Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Percentage Rural in Block Groups Where Facilities are Located</b><br>by Facility Security Level</span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 28.21% | 0.7% |
| MINIMUM | 34.74% | 7.75% |
| MEDIUM | 43.85% | 28.71% |
| MAXIMUM | 26.49% | 0% |
| CLOSE | 48.8% | 35.96% |
| NOT AVAILABLE | 36.68% | 10.88% |
#### Y-AXIS REPRESENTING FACILITIES RATHER THAN BLOCK GROUPS
##### percentage urbanized
prison_boundaries_block_census %>%
mutate(Median = median(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE)) %>%
select(pct_URBANIZED_AREA_POP_CEN_2010, Median, Mean) %>%
ggplot(aes(x = pct_URBANIZED_AREA_POP_CEN_2010 )) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Urbanized",
subtitle = "Mean in Blue, Median in Red\n2010 Census Data",
title = "Distribution of the Percentage Urbanized Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
ylim(0, 4100)
# percentage rural
prison_boundaries_block_census %>%
mutate(Median = median(pct_RURAL_POP_CEN_2010, na.rm = TRUE),
Mean = mean(pct_RURAL_POP_CEN_2010, na.rm = TRUE)) %>%
select(pct_RURAL_POP_CEN_2010, Median, Mean) %>%
ggplot(aes(x = pct_RURAL_POP_CEN_2010 )) +
geom_histogram() +
geom_vline(aes(xintercept = Median),
color = "darkred",
size = 1.2) +
geom_vline(aes(xintercept =Mean),
color = "#718BCE",
size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Rural",
subtitle = "Mean in Blue, Median in Red\n2010 Census data ",
title = "Distribution of the Percentage Rural Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
ylim(0, 4100)# for making tables
library(kableExtra)
# table of how many block groups had > 50% rural and how many had < 50% rural
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_RURAL_POP_CEN_2010,
pct_URBANIZED_AREA_POP_CEN_2010,
pct_URBAN_CLUSTER_POP_CEN_2010, SECURELVL) %>%
summarize(n=n()) %>%
ungroup() %>%
select(pct_URBANIZED_AREA_POP_CEN_2010,
pct_RURAL_POP_CEN_2010,
pct_URBAN_CLUSTER_POP_CEN_2010) %>%
mutate(Density = ifelse(pct_RURAL_POP_CEN_2010 > 50, "Rural", "Urban")) %>%
group_by(Density) %>%
summarize(n =n()) %>%
mutate(Density = replace_na(Density, "Missing"),
total = sum(n),
Percentage = (n / total)*100,
Percentage = paste0(as.character(round(Percentage, 2)), '%')) %>%
select(Density, Percentage) %>%
kbl(caption = "<span style = 'color:black;'><b>Percentage of Facilities in a Block Group that was Mostly Rural or Mostly Urban</b></span><br>Rural block groups are defined here as those where greater than 50% of the 2010 Census total\npopulation for that block group <br> was recorded to live outside of an urbanized area or urban cluster<br></span><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Density | Percentage |
|---|---|
| Rural | 31.56% |
| Urban | 67.77% |
| Missing | 0.67% |
# footnote("Rural block groups are defined here as those where greater than 50% of the 2010 Census total\npopulation for that block group was recorded to live outside of an urbanized area or urban cluster.")
# to add tab use  
### FOR COMPARISON -- table with mean and median percentages urbanized, urban cluster, and rural in the U.S.
blockgroup_level_data %>%
summarize(Urban = mean(pct_URBANIZED_AREA_POP_CEN_2010, na.rm = TRUE),
`Urban Cluster` = mean(pct_URBAN_CLUSTER_POP_CEN_2010, na.rm = TRUE),
Rural = mean(pct_RURAL_POP_CEN_2010, na.rm = TRUE)) %>%
pivot_longer(cols = 1:3, names_to = "Population Density Category",
values_to = "Mean Percentage") %>%
cbind("Median Percentage" = c(
median(blockgroup_level_data$pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE),
median(blockgroup_level_data$pct_URBAN_CLUSTER_POP_CEN_2010,
na.rm = TRUE),
median(blockgroup_level_data$pct_RURAL_POP_CEN_2010, na.rm = TRUE))) %>%
kbl(caption = "<span style = 'color:black;'><b>For Block Groups in the United States: Mean and Median Percentages in Urbanized, Urban Cluster, and Rural Areas</b></span><span style = 'float:center'><i><span><br> Data from the 2010 Census</i></span>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = F) %>%
row_spec(0, background = "#D9DFEE") | Population Density Category | Mean Percentage | Median Percentage |
|---|---|---|
| Urban | 69.00312 | 100 |
| Urban Cluster | 10.30077 | 0 |
| Rural | 20.69611 | 0 |
# table with mean and median percentages urbanized, urban cluster, and rural
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_RURAL_POP_CEN_2010,
pct_URBANIZED_AREA_POP_CEN_2010,
pct_URBAN_CLUSTER_POP_CEN_2010) %>%
summarize(n=n()) %>%
ungroup() %>%
summarize(x = c("Mean", "Median"),
Urban =c(mean(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE),
median(pct_URBANIZED_AREA_POP_CEN_2010,
na.rm = TRUE)),
`Urban Cluster` = c(mean(pct_URBAN_CLUSTER_POP_CEN_2010,
na.rm = TRUE),
median(pct_URBAN_CLUSTER_POP_CEN_2010,
na.rm = TRUE)),
Rural = c(mean(pct_RURAL_POP_CEN_2010,
na.rm = TRUE),
median(pct_RURAL_POP_CEN_2010,
na.rm = TRUE))) %>% # following lines transpose the tibble
pivot_longer(cols = -x , names_to = "temp") %>%
pivot_wider(names_from = x,
values_from = value) %>%
rename("Population Density Category" = temp) %>%
kbl(caption = "<span style = 'color:black;'><b> For Block Groups Where Facilities are Located: Mean and Median Percentages in Urbanized, Urban Cluster, and Rural Areas</b></span><span style = 'float:center'><i><span><br> Data from the 2010 Census</i></span>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = F) %>%
row_spec(0, background = "#D9DFEE") | Population Density Category | Mean | Median |
|---|---|---|
| Urban | 33.68880 | 0.00 |
| Urban Cluster | 30.94124 | 0.00 |
| Rural | 35.36997 | 8.87 |
We can also see how the distribution of age varies depending on whether blocks are primarily urban or rural, among different facility types, and among different facility security levels.
###### distribution of median age in rural versus urban settings, where rural blocks are defined as those
# where more than 50% of the population is rural
# mean of the distribution is higher in rural areas, a trend that has been reported elsewhere
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_RURAL_POP_CEN_2010,
TYPE, Median_Age_ACS_15_19) %>%
summarize() %>%
ungroup() %>%
mutate(Density = ifelse(pct_RURAL_POP_CEN_2010 > 50,
"Rural", "Urban")) %>%
group_by(Density, TYPE) %>%
mutate(Mean = mean(Median_Age_ACS_15_19,
na.rm =TRUE),
Median = median(Median_Age_ACS_15_19,
na.rm = TRUE)) %>%
filter(!is.na(Density)) %>%
ggplot(aes(x = Median_Age_ACS_15_19 )) +
facet_grid(TYPE~Density, scales = "free_y") +
geom_histogram(alpha = .8) +
geom_vline(aes(xintercept = Median ), color = "darkred") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Median Age",
subtitle = "Median of Each Distribution in Red\n2015 – 2019 5-year ACS sample data & 2010 Census Data",
title = "Distribution of Median Age in Block Groups Where Facilities are Located,\nBy Population Density and Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5),
strip.text = element_text(face = "bold"))# faceted by rural/urban status and security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_RURAL_POP_CEN_2010,
SECURELVL, Median_Age_ACS_15_19) %>%
summarize() %>%
ungroup() %>%
mutate(Density = ifelse(pct_RURAL_POP_CEN_2010 > 50,
"Rural", "Urban")) %>%
group_by(Density, SECURELVL) %>%
mutate(Mean = mean(Median_Age_ACS_15_19, na.rm =TRUE),
Median = median(Median_Age_ACS_15_19, na.rm = TRUE)) %>%
filter(!is.na(Density)) %>%
ggplot(aes(x = Median_Age_ACS_15_19 )) +
facet_grid(SECURELVL~Density, scales = "free_y") +
geom_histogram(alpha = .8) +
geom_vline(aes(xintercept = Median ), color = "darkred") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Median Age",
subtitle = "2015 – 2019 5-year ACS sample data & 2010 Census Data",
title = "Distribution of Median Age in Block Groups Where Facilities are Located\n by Population Density Category and Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5),
strip.text = element_text(face = "bold"))Distribution of Racial Percentages for each Racial Category
#
# mutate(sum_all = Hispanic_ACS_15_19 + NH_AIAN_alone_ACS_15_19 + NH_Asian_alone_ACS_15_19 + NH_Blk_alone_ACS_15_19 + NH_NHOPI_alone_ACS_15_19 + NH_SOR_alone_ACS_15_19 + NH_White_alone_ACS_15_19) %>% View()
# for race reference csv, copied and pasted definitions at link here https://api.census.gov/data/2021/pdb/blockgroup/variables.html into excel file
race_ref <- read_csv("./data/races_reference.csv", col_names = FALSE) %>%
select(X1, X2) %>%
rename(`Racial Category` = X1,
Description = X2) %>%
mutate(Description = str_replace(Description, "in the ACS", ""),
Description = str_replace(Description, ",", ",\n")) %>%
filter(!str_detect(Description, "Census") & !str_detect(Description, "MOE") )
# for full U.S.
blockgroup_level_data %>%
select(
Hispanic_ACS_15_19, NH_AIAN_alone_ACS_15_19,
NH_Asian_alone_ACS_15_19, NH_Blk_alone_ACS_15_19,
NH_NHOPI_alone_ACS_15_19, NH_SOR_alone_ACS_15_19,
NH_White_alone_ACS_15_19, Tot_Population_ACS_15_19) %>%
mutate(across(1:ncol(.), ~ (.x / Tot_Population_ACS_15_19) * 100)) %>% # get percentage by dividing by total for that block
select(-Tot_Population_ACS_15_19) %>%
pivot_longer(1:ncol(.), names_to = "Racial Category", values_to ="Percentage") %>%
left_join(race_ref, by = c("Racial Category" = "Racial Category")) %>%
group_by(Description) %>%
mutate(Median = median(Percentage, na.rm = TRUE),
Mean = mean(Percentage, na.rm = TRUE)) %>%
ggplot(aes(x = Percentage)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
facet_wrap(~Description, scales = "free_y", ncol = 2) +
scale_x_continuous(breaks = seq(0, 100, by = 10)) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage",
subtitle = "Median in Red, Mean in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of Racial Percentages in Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_y_continuous(labels = comma)prison_race <- prison_boundaries_block_census %>%
select(FACILITYID, TYPE, SECURELVL,
Hispanic_ACS_15_19, NH_AIAN_alone_ACS_15_19,
NH_Asian_alone_ACS_15_19, NH_Blk_alone_ACS_15_19,
NH_NHOPI_alone_ACS_15_19, NH_SOR_alone_ACS_15_19,
NH_White_alone_ACS_15_19, Tot_Population_ACS_15_19,
STATE, COUNTY, TRACTCE10, block_group) %>%
mutate(across(4:10, ~ (.x / Tot_Population_ACS_15_19) * 100)) %>% # get percentage by dividing by total for that block
select(-Tot_Population_ACS_15_19) %>%
pivot_longer(4:10, names_to = "Racial Category",
values_to ="Percentage") %>%
left_join(race_ref, by = c("Racial Category" = "Racial Category"))
# note that all block groups are represented in each facet, since each block group has a percentage for each racial category # for block groups where facilities are located
prison_race %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, `Racial Category`,
Description, Percentage) %>%
summarize(n=n()) %>%
ungroup() %>%
group_by(Description) %>%
mutate(Median = median(Percentage, na.rm = TRUE),
Mean = mean(Percentage, na.rm = TRUE)) %>%
ggplot(aes(x = Percentage)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
facet_wrap(~Description, scales = "free_y", ncol = 2) +
scale_x_continuous(breaks = seq(0, 100, by = 10)) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of Racial Percentages in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5))###### tables for comparison
us <- blockgroup_level_data %>%
select(
Hispanic_ACS_15_19, NH_AIAN_alone_ACS_15_19,
NH_Asian_alone_ACS_15_19, NH_Blk_alone_ACS_15_19,
NH_NHOPI_alone_ACS_15_19, NH_SOR_alone_ACS_15_19,
NH_White_alone_ACS_15_19, Tot_Population_ACS_15_19) %>%
mutate(across(1:ncol(.), ~ (.x / Tot_Population_ACS_15_19) * 100)) %>% # get percentage by dividing by total for that block
select(-Tot_Population_ACS_15_19) %>%
pivot_longer(1:ncol(.),
names_to = "Racial Category",
values_to ="Percentage") %>%
left_join(race_ref, by = c("Racial Category" = "Racial Category")) %>%
group_by(Description) %>%
summarize(Median = median(Percentage, na.rm = TRUE),
Mean = mean(Percentage, na.rm = TRUE)) %>%
rename(`Median for Block Groups in the U.S.` = Median,
`Mean for Block Groups in the U.S.` = Mean) %>%
mutate(Description = str_replace_all(Description, "\\n", "<br>"))
fac <- prison_race %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, `Racial Category`,
Description, Percentage) %>%
summarize(n=n()) %>%
ungroup() %>%
group_by(Description) %>%
summarize(Median = median(Percentage, na.rm = TRUE),
Mean = mean(Percentage, na.rm = TRUE)) %>%
rename(`Median for Block Groups<br>Where Facilities are Located` = Median,
`Mean for Block Groups<br>Where Facilities are Located` = Mean,
Description2 = Description)
cbind(us, fac) %>%
select(-Description2, Description,
`Median for Block Groups in the U.S.`,
`Median for Block Groups<br>Where Facilities are Located`,
`Mean for Block Groups in the U.S.`,
`Mean for Block Groups<br>Where Facilities are Located` ) %>%
mutate(across(2:5, ~paste0(round(., digits = 2), "%"))) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentages for Each Racial Category in Block Groups</b></span><br><i>Data from the 2015-2019 ACS</i>",
align = "l", escape = FALSE) %>%
kable_material(c("striped", "hover"), full_width = F) %>%
row_spec(0, background = "#D9DFEE") %>%
column_spec(1:2, width = "2cm")| Description | Median for Block Groups in the U.S. | Mean for Block Groups in the U.S. |
Median for Block Groups Where Facilities are Located |
Mean for Block Groups Where Facilities are Located |
|---|---|---|---|---|
|
American Indian and Alaska Native alone, not Hispanic or Latino population |
0% | 0.72% | 0% | 1.61% |
|
Asian alone, not Hispanic or Latino population |
0.65% | 4.63% | 0% | 1.83% |
|
Black or African American alone, not Hispanic or Latino population |
2.55% | 12.89% | 7.03% | 17.2% |
|
Native Hawaiian and Other Pacific Islander alone, not Hispanic or Latino population |
0% | 0.15% | 0% | 0.16% |
| Persons of Hispanic Origin | 6.69% | 17.2% | 5.92% | 14.43% |
|
Some other race alone, not Hispanic or Latino population |
0% | 0.23% | 0% | 0.16% |
|
White alone, not Hispanic or Latino population |
71.34% | 61.82% | 67.77% | 62.16% |
Distribution of Percentage without Health Insurance
As defined in the documentation,
No_Health_Ins_ACS_15_19is the “Number of people who have no health insurance coverage, public or private, in the ACS population”. To find the percentage lacking health insurance, we can divide by the total population,Tot_Population_ACS_15_19.
blockgroup_level_data %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100,
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE)) %>%
ggplot(aes(x = pct_no_insurance)) +
geom_histogram() +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Lacking Health Insurance",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Lacking Health Insurance in Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-3, 80) +
scale_y_continuous(labels = comma)prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, No_Health_Ins_ACS_15_19, Tot_Population_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100,
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE)) %>%
ggplot(aes(x = pct_no_insurance)) +
geom_histogram() +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Lacking Health Insurance",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Lacking Health Insurance\nin Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-3, 80)#### table for comparison
us <- blockgroup_level_data %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
No_Health_Ins_ACS_15_19,
Tot_Population_ACS_15_19 ) %>%
summarize() %>%
ungroup() %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100) %>%
summarize(Mean = mean(pct_no_insurance,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(pct_no_insurance,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Without Health Insurance in Block Groups</b></span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 8.62% | 6.2% |
| Block Groups Where Facilities are Located | 8.4% | 6.59% |
# by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, No_Health_Ins_ACS_15_19, Tot_Population_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>% group_by(TYPE) %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100,
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE)) %>%
ggplot(aes(x = pct_no_insurance)) +
geom_histogram() +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Lacking Health Insurance",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Lacking Health Insurance\nin Block Groups Where Facilities are Located\nBy Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-3, 80) # table by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, No_Health_Ins_ACS_15_19, Tot_Population_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>% group_by(TYPE) %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Without Health Insurance in Block Groups, By Facility Type</b></span><br><i>Data from the 2015 - 2019 ACS</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 11.46% | 9.31% |
| COUNTY | 9.05% | 7.39% |
| STATE | 6.67% | 4.75% |
| FEDERAL | 5.03% | 3.2% |
| MULTI | 7.86% | 5.82% |
| NOT AVAILABLE | 12.5% | 8.26% |
# by facility security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, No_Health_Ins_ACS_15_19, Tot_Population_ACS_15_19, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100,
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE)) %>%
ggplot(aes(x = pct_no_insurance)) +
geom_histogram() +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Lacking Health Insurance",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Lacking Health Insurance\nin Block Groups Where Facilities are Located\nBy Facility Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-3,80)# table by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, No_Health_Ins_ACS_15_19,
Tot_Population_ACS_15_19, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Without Health Insurance in Block Groups, By Security Level</b></span><br><i>Data from the 2015 - 2019 ACS</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 8.45% | 6.25% |
| MINIMUM | 7.14% | 5.62% |
| MEDIUM | 5.14% | 2.93% |
| MAXIMUM | 5.87% | 3.81% |
| CLOSE | 5.77% | 3.94% |
| NOT AVAILABLE | 9.52% | 7.75% |
### BY FACILITY, WHERE Y-AXIS IS NUMBER OF FACILITIES RATHER THAN BLOCK GROUPS
# faceted by facility type
prison_boundaries_block_census %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100) %>%
group_by(TYPE) %>%
mutate(
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE),
TYPE = factor(TYPE, levels = c("LOCAL", "COUNTY",
"STATE", "FEDERAL",
"MULTI", "NOT AVAILABLE"))) %>%
ggplot(aes(x = pct_no_insurance)) +
geom_histogram() +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Lacking Health Insurance",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Lacking Health Insurance in Block Groups Where Facilities are Located\nFaceted By Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(0,100)
# faceted by security level
prison_boundaries_block_census %>%
mutate(pct_no_insurance = (No_Health_Ins_ACS_15_19 / Tot_Population_ACS_15_19) * 100) %>%
group_by(SECURELVL) %>%
mutate(
Mean = mean(pct_no_insurance, na.rm = TRUE),
Median = median(pct_no_insurance, na.rm = TRUE),
SECURELVL = factor(SECURELVL, levels = c("JUVENILE", "MINIMUM",
"MEDIUM", "MAXIMUM",
"CLOSE", "NOT AVAILABLE"))) %>%
ggplot(aes(x = pct_no_insurance)) +
geom_histogram() +
facet_wrap(~SECURELVL, scales = "free_y", ncol = 2) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Lacking Health Insurance",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Lacking Health Insurance in Block Groups Where Facilities are Located\nFaceted By Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(0,100)Distribution of Percentages Below the Poverty Level
Referencing the documentation:
Prs_Blw_Pov_Lev_ACS_15_19is defined as the “Number of people classified as below the poverty level given their total family or household income within the last year, family size, and family composition in the ACS population”. To calculate the percentage, we can use thePov_Univ_ACS_15_19variable, which is defined as the “Population for whom poverty level is determined”.
#### FOR COMPARISON -- poverty distribution for all block groups in the U.S.
blockgroup_level_data %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100,
Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
ggplot(aes(x = pct_below_pov)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Below the Poverty Line in Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100) +
scale_y_continuous(labels = comma)prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Prs_Blw_Pov_Lev_ACS_15_19, Pov_Univ_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100,
Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
ggplot(aes(x = pct_below_pov)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Below the Poverty Line",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Below the Poverty Line in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)#### table for comparison
us <- blockgroup_level_data %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
Prs_Blw_Pov_Lev_ACS_15_19,
Pov_Univ_ACS_15_19 ) %>%
summarize() %>%
ungroup() %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100) %>%
summarize(Mean = mean(pct_below_pov,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(pct_below_pov,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Below the Poverty Line in Block Groups</b></span><br><i>Data from the 2015 - 2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 14.88% | 10.45% |
| Block Groups Where Facilities are Located | 20% | 15.64% |
# by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Prs_Blw_Pov_Lev_ACS_15_19, Pov_Univ_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100) %>%
group_by(TYPE) %>%
mutate(Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
ggplot(aes(x = pct_below_pov)) +
geom_histogram(alpha = .9) +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Below the Poverty Line",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Below the Poverty Line in Block Groups Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)# table by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Prs_Blw_Pov_Lev_ACS_15_19,
Pov_Univ_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>% group_by(TYPE) %>%
mutate(pct_below = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_below, na.rm = TRUE),
Median = median(pct_below, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Below the Poverty Line in Block Groups, By Facility Type</b></span><br><i>Data from the 2015 - 2019 ACS</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 21.96% | 18.15% |
| COUNTY | 20.06% | 16.23% |
| STATE | 19.71% | 14.45% |
| FEDERAL | 18.6% | 14.63% |
| MULTI | 25% | 23.34% |
| NOT AVAILABLE | 21.38% | 15.34% |
# by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Prs_Blw_Pov_Lev_ACS_15_19, Pov_Univ_ACS_15_19, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100) %>%
group_by(SECURELVL) %>%
mutate(Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
ggplot(aes(x = pct_below_pov)) +
geom_histogram(alpha = .9) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Below the Poverty Line",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Below the Poverty Line in Block Groups Where Facilities are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)# table by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Prs_Blw_Pov_Lev_ACS_15_19,
Pov_Univ_ACS_15_19, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(pct_below = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_below, na.rm = TRUE),
Median = median(pct_below, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Below the Poverty Line in Block Groups, By Facility Security Level</b></span><br><i>Data from the 2015 - 2019 ACS</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 19.32% | 14.31% |
| MINIMUM | 21.34% | 15.87% |
| MEDIUM | 19.17% | 14.45% |
| MAXIMUM | 20.7% | 15.27% |
| CLOSE | 20.01% | 15.05% |
| NOT AVAILABLE | 20.14% | 16.48% |
#### BY FACILITY TYPE -- Y-AXIS REPRESENTS NUMBER OF FACILITIES
# for block groups where facilities are located
prison_boundaries_block_census %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100,
Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
ggplot(aes(x = pct_below_pov)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Below the Poverty Line",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Below the Poverty Line in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)
# by facility type
prison_boundaries_block_census %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100,
TYPE = factor(TYPE, levels = c("LOCAL", "COUNTY",
"STATE", "FEDERAL",
"MULTI", "NOT AVAILABLE"))) %>%
group_by(TYPE) %>%
mutate(Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
ggplot(aes(x = pct_below_pov)) +
geom_histogram(alpha = .9) +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Below the Poverty Line",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Below the Poverty Line in Block Groups Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)
# by security level
prison_boundaries_block_census %>%
mutate(pct_below_pov = (Prs_Blw_Pov_Lev_ACS_15_19 / Pov_Univ_ACS_15_19) * 100,
SECURELVL = factor(SECURELVL, levels = c("JUVENILE", "MINIMUM",
"MEDIUM", "MAXIMUM",
"CLOSE", "NOT AVAILABLE"))) %>%
group_by(SECURELVL) %>%
mutate(Mean = mean(pct_below_pov, na.rm = TRUE),
Median = median(pct_below_pov, na.rm = TRUE)) %>%
ggplot(aes(x = pct_below_pov)) +
geom_histogram(alpha = .9) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Below the Poverty Line",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Below the Poverty Line in Block Groups Where Facilities are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)Distribution of the Percentage of Housing Units Rented
Renter_Occp_HU_ACS_15_19is defined as “Number of ACS occupied housing units that are not owner occupied, whether they are rented or occupied without payment of rent”.
# distribution of percentage of housing units rented
blockgroup_level_data %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100,
Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
ggplot(aes(x = pct_rented)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage of Housing Units Rented",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage of Occupied Housing Units Not Owner Occupied\nin Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100) +
scale_y_continuous(labels = comma)# distribution of percentage of housing units rented in block groups with facilities
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Renter_Occp_HU_ACS_15_19, Tot_Occp_Units_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100,
Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
ggplot(aes(x = pct_rented)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage of Housing Units Rented",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage of Occupied Housing Units Not Owner Occupied\n in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)#### table for comparison
us <- blockgroup_level_data %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
Renter_Occp_HU_ACS_15_19,
Tot_Occp_Units_ACS_15_19 ) %>%
summarize() %>%
ungroup() %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100) %>%
summarize(Mean = mean(pct_rented,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(pct_rented,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage of Occupied Housing Units Not Owner Occupied in Block Groups</b></span><br><i>Data from the 2015 - 2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 35.51% | 29.47% |
| Block Groups Where Facilities are Located | 40.9% | 36.18% |
# by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Renter_Occp_HU_ACS_15_19, Tot_Occp_Units_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100) %>%
group_by(TYPE) %>%
mutate(Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
ggplot(aes(x = pct_rented)) +
geom_histogram(alpha = .9) +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage of Housing Units Rented",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage of Occupied Housing Units Not Owner Occupied\n in Block Groups Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)# table by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Renter_Occp_HU_ACS_15_19,
Tot_Occp_Units_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>% group_by(TYPE) %>%
mutate(pct_below = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_below, na.rm = TRUE),
Median = median(pct_below, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Occupied Housing Units Not Owner Occupied in Block Groups, By Facility Type</b></span><br><i>Data from the 2015 - 2019 ACS</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 56.42% | 56% |
| COUNTY | 41.89% | 38.07% |
| STATE | 35.59% | 29.26% |
| FEDERAL | 42.36% | 33.62% |
| MULTI | 41.69% | 31.98% |
| NOT AVAILABLE | 35.46% | 33.69% |
# by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Renter_Occp_HU_ACS_15_19, Tot_Occp_Units_ACS_15_19, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100) %>%
group_by(SECURELVL) %>%
mutate(Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
ggplot(aes(x = pct_rented)) +
geom_histogram(alpha = .9) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage of Housing Units Rented",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage of Occupied Housing Units Not Owner Occupied\n in Block Groups Where Facilities are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)# table by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Renter_Occp_HU_ACS_15_19,
Tot_Occp_Units_ACS_15_19, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(pct_below = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100) %>%
summarize(
Mean = mean(pct_below, na.rm = TRUE),
Median = median(pct_below, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Occupied Housing Units Not Owner Occupied in Block Groups, By Security Level</b></span><br><i>Data from the 2015 - 2019 ACS</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 40.2% | 35.79% |
| MINIMUM | 41.35% | 34.17% |
| MEDIUM | 33.26% | 27.6% |
| MAXIMUM | 44.18% | 38.44% |
| CLOSE | 31.54% | 26.34% |
| NOT AVAILABLE | 41.89% | 38.61% |
#### BY FACILITY, WHERE Y-AXIS REPRESENTS NUMBER OF FACILITIES RATHER THAN BLOCK GROUPS
prison_boundaries_block_census %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100,
Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
ggplot(aes(x = pct_rented)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage of Housing Units Rented",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage of Occupied Housing Units Not Owner Occupied\n in Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)
# by facility type
prison_boundaries_block_census %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100,
TYPE = factor(TYPE, levels = c("LOCAL", "COUNTY",
"STATE", "FEDERAL",
"MULTI", "NOT AVAILABLE"))) %>%
group_by(TYPE) %>%
mutate(Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
ggplot(aes(x = pct_rented)) +
geom_histogram(alpha = .9) +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage of Housing Units Rented",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage of Occupied Housing Units Not Owner Occupied\n in Block Groups Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)
# by security level
prison_boundaries_block_census %>%
mutate(pct_rented = (Renter_Occp_HU_ACS_15_19 / Tot_Occp_Units_ACS_15_19) * 100,
SECURELVL = factor(SECURELVL, levels = c("JUVENILE", "MINIMUM",
"MEDIUM", "MAXIMUM",
"CLOSE", "NOT AVAILABLE"))) %>%
group_by(SECURELVL) %>%
mutate(Mean = mean(pct_rented, na.rm = TRUE),
Median = median(pct_rented, na.rm = TRUE)) %>%
ggplot(aes(x = pct_rented)) +
geom_histogram(alpha = .9) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage of Housing Units Rented",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage of Occupied Housing Units Not Owner Occupied\n in Block Groups Where Facilities are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(-5,100)Distribution of Average Household Size
Tot_Prns_in_HHD_ACS_15_19is defined as the “All persons (household population) in ACS occupied housing unit. This is the numerator to calculate the average household size”. The denominator used to calculate the average household size isTot_Occp_Units_ACS_15_19.
# distribution of average household size for block groups in the U.S.
blockgroup_level_data %>%
mutate(avg_house = Tot_Prns_in_HHD_ACS_15_19 / Tot_Occp_Units_ACS_15_19,
Mean = mean(avg_house, na.rm = TRUE),
Median = median(avg_house, na.rm = TRUE)) %>%
ggplot(aes(x = avg_house)) +
geom_histogram(alpha = .9, bins = 40) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Average Household Size",
subtitle = "Median in Red, Mean in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Average Household Size\nin Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
xlim(0, 8) +
scale_y_continuous(labels = comma)prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, Tot_Prns_in_HHD_ACS_15_19, Tot_Occp_Units_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(avg_house = Tot_Prns_in_HHD_ACS_15_19 / Tot_Occp_Units_ACS_15_19,
Mean = mean(avg_house, na.rm = TRUE),
Median = median(avg_house, na.rm = TRUE)) %>%
ggplot(aes(x = avg_house)) +
geom_histogram(alpha = .9, bins = 40) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Average Household Size",
subtitle = "Median in Red, Mean in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Average Household Size\nin Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic",
hjust = .5),
plot.title = element_text(face = "bold",
hjust = 0.5)) +
xlim(0, 8)#### table for comparison
us <- blockgroup_level_data %>%
mutate(avg_house = Tot_Prns_in_HHD_ACS_15_19 / Tot_Occp_Units_ACS_15_19) %>%
summarize(
Mean = mean(avg_house, na.rm = TRUE),
Median = median(avg_house, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
Tot_Prns_in_HHD_ACS_15_19,
Tot_Occp_Units_ACS_15_19 ) %>%
summarize() %>%
ungroup() %>%
mutate(avg_house = Tot_Prns_in_HHD_ACS_15_19 / Tot_Occp_Units_ACS_15_19) %>%
summarize(Mean = mean(avg_house,
na.rm = TRUE),
Mean = round(Mean, digits = 1),
Median = median(avg_house,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~round(., digits=2))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Average Household Size in Block Groups (Units are People)</b></span><br><i>Data from the 2015 - 2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 2.64 | 2.57 |
| Block Groups Where Facilities are Located | 2.50 | 2.41 |
##### BY FACILITY RATHER THAN BY BLOCK GROUP
prison_boundaries_block_census %>%
mutate(avg_house = Tot_Prns_in_HHD_ACS_15_19 / Tot_Occp_Units_ACS_15_19,
Mean = mean(avg_house, na.rm = TRUE),
Median = median(avg_house, na.rm = TRUE)) %>%
ggplot(aes(x = avg_house)) +
geom_histogram(alpha = .9, bins = 40) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Average Household Size",
subtitle = "Median in Red, Mean in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Average Household Size\nin Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic",
hjust = .5),
plot.title = element_text(face = "bold",
hjust = 0.5)) +
xlim(0, 8)Distribution of Percentage Institutionalized
pct_Inst_GQ_CEN_2010is defined as “The percentage of the 2010 Census population who live in group quarters and are primarily ineligible, unable, or unlikely to participate in labor force while residents. Institutional group quarters include correctional facilities for adults, juvenile facilities, nursing facilities, and other institutional facilities.”
# distribution of the Percentage Living in Institutional Group Quarters across all block groups in the U.S.
blockgroup_level_data %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) # distribution of the Percentage Living in Institutional Group Quarters in block groups where facilities are
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_Inst_GQ_CEN_2010) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups Where Facilities Are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5),
limits = c(-3,105)) #### table for comparison
us <- blockgroup_level_data %>%
summarize(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_Inst_GQ_CEN_2010 ) %>%
summarize() %>%
ungroup() %>%
summarize(Mean = mean(pct_Inst_GQ_CEN_2010,
na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage in Institutionalized Group Quarters in Block Groups</b></span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 1.04% | 0% |
| Block Groups Where Facilities are Located | 19.94% | 8.33% |
# distribution of the Percentage Living in Institutional Group Quarters in block groups where facilities are,
# faceted by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_Inst_GQ_CEN_2010, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(TYPE) %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups Where Facilities Are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 20),
limits = c(-3,105)) # table by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group,
pct_Inst_GQ_CEN_2010, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(TYPE) %>%
summarize(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Living in Institutional Group Quarters in Block Groups, By Facility Type</b></span><br><i>Data from the 2010 Census</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 7.88% | 0.74% |
| COUNTY | 14.13% | 7.1% |
| STATE | 34.09% | 21.39% |
| FEDERAL | 54.2% | 55.56% |
| MULTI | 39.7% | 32.98% |
| NOT AVAILABLE | 7.05% | 1.71% |
# distribution of the Percentage Living in Institutional Group Quarters in block groups where facilities are,
# faceted by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_Inst_GQ_CEN_2010, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups Where Facilities Are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 20),
limits = c(-3,105)) # table by facility security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group,
pct_Inst_GQ_CEN_2010, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
summarize(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Living in Institutional Group Quarters in Block Groups, By Facility Security Level</b></span><br><i>Data from the 2010 Census</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 15.04% | 5.83% |
| MINIMUM | 30.11% | 16.72% |
| MEDIUM | 52.74% | 53.98% |
| MAXIMUM | 42.82% | 35.51% |
| CLOSE | 57.37% | 55.32% |
| NOT AVAILABLE | 12.91% | 5.96% |
# distribution of the Percentage Living in Institutional Group Quarters in block groups where facilities are,
# faceted by STATE##### BY FACILITY RATHER THAN BY BLOCK GROUP; Y-AXIS REPRESENTS NUMBER OF FACILITIES
# distribution of the Percentage Living in Institutional Group Quarters in block groups where facilities are
prison_boundaries_block_census %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups Where Facilities Are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5),
limits = c(-3,105))
# distribution of the Percentage Living in Institutional Group Quarters in block groups where facilities are,
# faceted by facility type
prison_boundaries_block_census %>%
group_by(TYPE) %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
TYPE = factor(TYPE, levels = c("LOCAL", "COUNTY",
"STATE", "FEDERAL",
"MULTI", "NOT AVAILABLE"))) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups Where Facilities Are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 20),
limits = c(-3,105))
# distribution of the Percentage Living in Institutional Group Quarters in block groups where facilities are,
# faceted by security level
prison_boundaries_block_census %>%
group_by(SECURELVL) %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
SECURELVL = factor(SECURELVL, levels = c("JUVENILE", "MINIMUM",
"MEDIUM", "MAXIMUM",
"CLOSE", "NOT AVAILABLE"))) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups Where Facilities Are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 20),
limits = c(-3,105)) prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, pct_Inst_GQ_CEN_2010) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(STATE) %>%
mutate(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Inst_GQ_CEN_2010)) +
geom_histogram(alpha = .9) +
facet_wrap(~STATE, scales = "free_y", ncol = 5) +
geom_vline(aes(xintercept = Median), color = "darkred", size = 1.2) +
geom_vline(aes(xintercept = Mean), color = "#718BCE", size = 1.2) +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage in Institutional Group Quarters",
subtitle = "Median Percentages in Red, Mean Percentages in Blue\n2010 Census data",
title = "Distribution of the Percentage Living in Institutional Group Quarters\nin Block Groups Where Facilities Are Located\nFaceted by State") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 20),
limits = c(-3,105)) # table by state
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group,
pct_Inst_GQ_CEN_2010) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(STATE) %>%
summarize(
Mean = mean(pct_Inst_GQ_CEN_2010, na.rm = TRUE),
Median = median(pct_Inst_GQ_CEN_2010, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Living in Institutional Group Quarters in Block Groups, By State</b></span><br><i>Data from the 2010 Census</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | STATE | Mean | Median |
|---|---|---|
| AK | 9.73% | 5.14% |
| AL | 15.16% | 7.26% |
| AR | 15.04% | 7.25% |
| AZ | 36.06% | 19.95% |
| CA | 24.86% | 7.96% |
| CO | 21.88% | 9.91% |
| CT | 55.18% | 62.98% |
| DC | 29.74% | 2.95% |
| DE | 35.23% | 18.73% |
| FL | 27.29% | 14.52% |
| GA | 17.42% | 9.05% |
| GU | NaN% | NA% |
| HI | 37.13% | 24.39% |
| IA | 8.28% | 3.54% |
| ID | 8.93% | 3.66% |
| IL | 19.19% | 6.96% |
| IN | 16.93% | 9.82% |
| KS | 9.94% | 2.97% |
| KY | 18.41% | 12.67% |
| LA | 19.68% | 10.96% |
| MA | 30.77% | 23.45% |
| MD | 29.04% | 14.17% |
| ME | 11.99% | 12.28% |
| MI | 22.38% | 9.3% |
| MN | 9.78% | 3.58% |
| MO | 13.84% | 6.08% |
| MS | 15.2% | 7.48% |
| MT | 10.35% | 2.86% |
| NC | 20.57% | 13.87% |
| ND | 8.48% | 4.8% |
| NE | 9.44% | 3.29% |
| NH | 19.46% | 12.3% |
| NJ | 32.54% | 20.87% |
| NM | 22.69% | 13.38% |
| NV | 17.41% | 4.19% |
| NY | 27.14% | 9.52% |
| OH | 20.59% | 9.88% |
| OK | 18.12% | 8.94% |
| OR | 19.61% | 9.01% |
| PA | 32.33% | 21.94% |
| PR | 27.01% | 10.54% |
| RI | 31.91% | 14.62% |
| SC | 26.78% | 15.1% |
| SD | 11.01% | 4.98% |
| TN | 17.57% | 8.96% |
| TX | 23.26% | 7.49% |
| UT | 11.81% | 5.95% |
| VA | 26.47% | 14.17% |
| VI | NaN% | NA% |
| VT | 11.99% | 11.54% |
| WA | 19.15% | 6.24% |
| WI | 19.71% | 10.92% |
| WV | 11.02% | 3.32% |
| WY | 8.45% | 5.34% |
Distribution of the Percentage Receiving Public Assistance Income
pct_PUB_ASST_INC_ACS_15_19is the “percentage of all ACS occupied housing units that receive public assistance income (general assistance and Temporary Assistance to Needy Families).” There are two main categories of public assistance programs, social welfare programs and social insurance programs. Social welfare programs generally have low income criteria for eligibility, and include programs such as Supplemental Security Income (SSI), Supplemental Nutrition Assistance Program (SNAP), Special Supplemental Nutrition Program for Women, Infants, and Children (WIC) Temporary Assistance for Needy Families (TANF), and General Assistance (GA). Social insurance programs, meanwhile, are based on criteria outside income, such as age, employment status, or being a veteran. These include Social security (self and on behalf of a dependent child), Department of Veterans’ Affairs benefits (except Veteran’s pension), Unemployment insurance compensation, and Workers’ compensation.
# distribution of percentage receiving public assistance income in block groups in the U.S.
blockgroup_level_data %>%
mutate(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_PUB_ASST_INC_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Receiving Public Assistance Income",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Receiving Public Assistance Income\nin Block Groups in the U.S.") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 60, by = 10), limits = c(-3,60))# distribution of percentage receiving public assistance income in block groups where facilities are located
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group,
pct_PUB_ASST_INC_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_PUB_ASST_INC_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Receiving Public Assistance Income",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Receiving Public Assistance Income\nin Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 60, by = 10), limits = c(-3,60))#### table for comparison
us <- blockgroup_level_data %>%
summarize(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_PUB_ASST_INC_ACS_15_19 ) %>%
summarize() %>%
ungroup() %>%
summarize(Mean = mean(pct_PUB_ASST_INC_ACS_15_19,
na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Receiving Public Assistance Income in Block Groups</b></span><br><i>Data from the 2010 Census</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 2.65% | 1.06% |
| Block Groups Where Facilities are Located | 2.89% | 1.45% |
# distribution of percentage receiving public assistance income in block groups where facilities are located
# faceted by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, TYPE,
pct_PUB_ASST_INC_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(TYPE) %>%
mutate(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_PUB_ASST_INC_ACS_15_19)) +
geom_histogram(alpha = .9, bins = 40) + facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Receiving Public Assistance Income",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Receiving Public Assistance Income\nin Block Groups Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 50, by = 10), limits = c(-3,50))# table by facility type
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group,
pct_PUB_ASST_INC_ACS_15_19, TYPE) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(TYPE) %>%
summarize(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Type` = TYPE) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Receiving Public Assistance Income in Block Groups, By Facility Type</b></span><br><i>Data from the 2010 Census</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Type | Mean | Median |
|---|---|---|
| LOCAL | 3.79% | 2.05% |
| COUNTY | 2.85% | 1.48% |
| STATE | 2.75% | 1.34% |
| FEDERAL | 2.29% | 0% |
| MULTI | 3.27% | 2.19% |
| NOT AVAILABLE | 4.26% | 0.74% |
# distribution of percentage receiving public assistance income in block groups where facilities are located
# faceted by security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group, SECURELVL,
pct_PUB_ASST_INC_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
mutate(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_PUB_ASST_INC_ACS_15_19)) +
geom_histogram(alpha = .9, bins = 40) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage Receiving Public Assistance Income",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Receiving Public Assistance Income\nin Block Groups Where Facilities are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 50, by = 10), limits = c(-3,50))# table by facility security level
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group,
pct_PUB_ASST_INC_ACS_15_19, SECURELVL) %>%
summarize(n = n()) %>%
ungroup() %>%
group_by(SECURELVL) %>%
summarize(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
rename(`Facility Security Level` = SECURELVL) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Receiving Public Assistance Income in Block Groups, By Facility Security Level</b></span><br><i>Data from the 2010 Census</i>",
align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Facility Security Level | Mean | Median |
|---|---|---|
| JUVENILE | 3.22% | 1.57% |
| MINIMUM | 2.92% | 1.5% |
| MEDIUM | 2.47% | 0.94% |
| MAXIMUM | 3.01% | 1.25% |
| CLOSE | 2.18% | 0.61% |
| NOT AVAILABLE | 2.82% | 1.48% |
##### BY FACILITY, WHERE Y-AXIS IS THE NUMBER OF FACILITIES
# distribution of percentage receiving public assistance income in block groups where facilities are located
prison_boundaries_block_census %>%
mutate(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_PUB_ASST_INC_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Receiving Public Assistance Income",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Receiving Public Assistance Income\nin Block Groups Where Facilities are Located") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105))
# distribution of percentage receiving public assistance income in block groups where facilities are located
# faceted by facility type
prison_boundaries_block_census %>%
group_by(TYPE) %>%
mutate(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_PUB_ASST_INC_ACS_15_19)) +
geom_histogram(alpha = .9, bins = 40) + facet_wrap(~TYPE, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Receiving Public Assistance Income",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Receiving Public Assistance Income\nin Block Groups Where Facilities are Located\nFaceted by Facility Type") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 10), limits = c(-3,105))
# distribution of percentage receiving public assistance income in block groups where facilities are located
# faceted by security level
prison_boundaries_block_census %>%
group_by(SECURELVL) %>%
mutate(
Mean = mean(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE),
Median = median(pct_PUB_ASST_INC_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_PUB_ASST_INC_ACS_15_19)) +
geom_histogram(alpha = .9, bins = 40) +
facet_wrap(~SECURELVL, scales = "free_y") +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Receiving Public Assistance Income",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = "Distribution of the Percentage Receiving Public Assistance Income\nin Block Groups Where Facilities are Located\nFaceted by Security Level") +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 10), limits = c(-3,105))Distribution of Percentage Where No Adult Speaks English “Very Well”
pct_ENG_VW_ACS_15_19is defined as the “percentage of all ACS occupied housing units where no one ages 14 years and over speaks English only or speaks English ‘very well’”.
# distribution across the U.S.
blockgroup_level_data %>%
mutate(
Mean = mean(pct_ENG_VW_ACS_15_19, na.rm = TRUE),
Median = median(pct_ENG_VW_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_ENG_VW_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage Where No One Over 14 in the Household Speaks English "Very Well"\nin Block Groups in the U.S.') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) #distribution in block groups where facilities are located
prison_boundaries_block_census %>%
group_by(STATE, COUNTY, TRACTCE10,
block_group,
pct_ENG_VW_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(
Mean = mean(pct_ENG_VW_ACS_15_19, na.rm = TRUE),
Median = median(pct_ENG_VW_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_ENG_VW_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Block Groups",
x = "Percentage",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage Where No One Over 14 in the Household Speaks English "Very Well" \nin Block Groups Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) #### table for comparison
us <- blockgroup_level_data %>%
summarize(
Mean = mean(pct_ENG_VW_ACS_15_19, na.rm = TRUE),
Median = median(pct_ENG_VW_ACS_15_19, na.rm = TRUE)) %>%
mutate(region = "Block Groups in the U.S.")
fac <- prison_boundaries_block_census %>%
group_by(STATE, COUNTY,
TRACTCE10, block_group,
pct_ENG_VW_ACS_15_19 ) %>%
summarize() %>%
ungroup() %>%
summarize(Mean = mean(pct_ENG_VW_ACS_15_19,
na.rm = TRUE),
Median = median(pct_ENG_VW_ACS_15_19,
na.rm = TRUE)) %>%
mutate(region = "Block Groups Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Percentage Where No One Over 14 in the Household Speaks English 'Very Well' in Block Groups</b></span><br><i>Data from the 2015 - 2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Block Groups in the U.S. | 5.17% | 0% |
| Block Groups Where Facilities are Located | 3.46% | 0% |
###### BY FACILITY, WHERE Y-AXIS REPRESENTS NUMBER OF FACILITIES
#distribution in block groups where facilities are located
prison_boundaries_block_census %>%
mutate(
Mean = mean(pct_ENG_VW_ACS_15_19, na.rm = TRUE),
Median = median(pct_ENG_VW_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_ENG_VW_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage Where No One Over 14 in the Household Speaks English "Very Well" \nin Block Groups Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) Tract Level Analysis
Some variables are not available at the block group level, but still may be relevant. These include the percentage of the population lacking a computing device, the percentage of the popoulation with broadband internet access and a computing device, and the percentage of the population 16 years and older who are unemployed.
get_census_data_tract <- function(state_code) {
region_for_state = paste0("state:", state_code, "+county:*")
result <- tryCatch(
{
getCensus(name = "pdb/tract",
vintage = 2021,
key = "fbbc8b0d3e53089da7cabc380628d6d46ae00444",
vars = c(
"pct_Pop_NoCompDevic_ACS_15_19",
"pct_Pop_w_BroadComp_ACS_15_19",
"pct_Civ_unemp_16p_ACS_15_19"
),
regionin = region_for_state,
region = "tract:*")
} ,
error=function(e) {
return()
}
)
return(result)
}
### NOTE -- attempted trying to get the following variables as well, but they just returned NAs
# Aggregate_HH_INC_ACS_15_19
# Med_HHD_Inc_ACS_15_19
# avg_Agg_HH_INC_ACS_15_19
# Med_HHD_Inc_ACS_15_19_1
# Med_House_Value_ACS_15_19
# get tract level data for all states, only run this section if changing the variables from function above
#tract_level_data <- map_dfr(state_codes, ~get_census_data_tract(.x))
#write_csv(tract_level_data, "./data/tract_level_data.csv")
tract_level_data <- read_csv("./data/tract_level_data.csv")
prison_tract <- left_join(prison_boundaries_blocks, tract_level_data,
by = c("STATEFP10" = "state",
"COUNTYFP10" = "county",
"TRACTCE10" = "tract"))Distribution of Percentages Lacking a Computing Device
The tract level data has additional variables available, and separate documentation outlining the definitions.
The variable
pct_Pop_NoCompDevic_ACS_15_19is defined as the “Percentage of people that live in households that do not have computing device of any kind in the ACS”.
# across U.S.
tract_level_data %>%
mutate(
Mean = mean(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Pop_NoCompDevic_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Tracts",
x = "Percentage Without a Computing Device",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of the Population Without a Computing Device\nin Tracts in the U.S.') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) # for tracts where facilities are located
prison_tract %>%
group_by(STATE, COUNTY, TRACTCE10,
pct_Pop_NoCompDevic_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(
Mean = mean(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Pop_NoCompDevic_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Tracts",
x = "Percentage Without a Computing Device",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of the Population Without a Computing Device\nin Tracts Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) #### table for comparison
us <- tract_level_data %>%
summarize(
Mean = mean(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE)) %>%
mutate(region = "Tracts in the U.S.")
fac <- prison_tract %>%
group_by(STATE, COUNTY, TRACTCE10,
pct_Pop_NoCompDevic_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
summarize(Mean = mean(pct_Pop_NoCompDevic_ACS_15_19,
na.rm = TRUE),
Median = median(pct_Pop_NoCompDevic_ACS_15_19,
na.rm = TRUE)) %>%
mutate(region = "Tracts Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the of the Population Without a Computing Device in Tracts</b></span><br><i>Data from the 2015 - 2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Tracts in the U.S. | 7.29% | 5.56% |
| Tracts Where Facilities are Located | 10.16% | 8.8% |
##### BY FACILITY, WHERE Y-AXIS IS THE NUMBER OF FACILITIES
# for tracts where facilities are located
prison_tract %>%
mutate(
Mean = mean(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_NoCompDevic_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Pop_NoCompDevic_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage Without a Computing Device",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of the Population Without a Computing Device\nin Tracts Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) Distribution of Percentages With Access to Broadband Wifi
The variable
pct_Pop_w_BroadComp_ACS_15_19is defined as the “Percentage of people that live in households that have both broadband Internet access and a computing device of any kind in the ACS”.
The thresholds for upload and download speeds are set by the Federal Communications Commission, and have changed over time, shaping our view on the digital divides that exist.
# across the U.S.
tract_level_data %>%
mutate(
Mean = mean(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Pop_w_BroadComp_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Tracts",
x = "Percentage With Broadband Internet Access",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of the Population with Broadband Internet Access\nin Tracts in the U.S.') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) # for tracts where facilities are located
prison_tract %>%
group_by(STATE, COUNTY, TRACTCE10,
pct_Pop_w_BroadComp_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(
Mean = mean(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Pop_w_BroadComp_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Tracts",
x = "Percentage With Broadband Internet Access",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of the Population with Broadband Internet Access\nin Tracts Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) #### table for comparison
us <- tract_level_data %>%
summarize(
Mean = mean(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE)) %>%
mutate(region = "Tracts in the U.S.")
fac <- prison_tract %>%
group_by(STATE, COUNTY, TRACTCE10,
pct_Pop_w_BroadComp_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
summarize(Mean = mean(pct_Pop_w_BroadComp_ACS_15_19,
na.rm = TRUE),
Median = median(pct_Pop_w_BroadComp_ACS_15_19,
na.rm = TRUE)) %>%
mutate(region = "Tracts Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of the Population with Broadband Internet Access in Tracts</b></span><br><i>Data from the 2015 - 2019 ACS</i>", align = "l") %>%
kable_material(c("striped", "hover"), full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Tracts in the U.S. | 84.63% | 87.08% |
| Tracts Where Facilities are Located | 79.68% | 81.41% |
##### BY FACILITY TYPE, WHERE Y-AXIS REPRESENTS NUMBER OF FACILITIES
# for tracts where facilities are lcoated
prison_tract %>%
mutate(
Mean = mean(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE),
Median = median(pct_Pop_w_BroadComp_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Pop_w_BroadComp_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage With Broadband Internet Access",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of the Population With Broadband Internet Access\nin Tracts Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) Distribution of the Percentage Unemployed
The variable
pct_Civ_unemp_16p_ACS_15_19is defined as the “percentage of ACS civilians ages 16 years and over in the labor force that are unemployed”.
# across the U.S.
tract_level_data %>%
mutate(
Mean = mean(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE),
Median = median(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Civ_unemp_16p_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Tracts",
x = "Percentage of Civilians Ages 16+ Unemployed",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of Civilians Ages 16+ in the Labor Force Who are Unemployed\nin Tracts in the U.S.') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) # in tracts where facilities are located
prison_tract %>%
group_by(STATE, COUNTY, TRACTCE10,
pct_Civ_unemp_16p_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
mutate(
Mean = mean(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE),
Median = median(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Civ_unemp_16p_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Tracts",
x = "Percentage of Civilians Ages 16+ Unemployed",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of Civilians Ages 16+ in the Labor Force Who are Unemployed\nin Tracts Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105)) #### table for comparison
us <- tract_level_data %>%
summarize(
Mean = mean(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE),
Median = median(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE)) %>%
mutate(region = "Tracts in the U.S.")
fac <- prison_tract %>%
group_by(STATE, COUNTY, TRACTCE10,
pct_Civ_unemp_16p_ACS_15_19) %>%
summarize(n = n()) %>%
ungroup() %>%
summarize(Mean = mean(pct_Civ_unemp_16p_ACS_15_19,
na.rm = TRUE),
Median = median(pct_Civ_unemp_16p_ACS_15_19,
na.rm = TRUE)) %>%
mutate(region = "Tracts Where\nFacilities are Located")
rbind(us, fac) %>%
mutate(across(c(Mean, Median), ~paste0( round(., digits=2), "%"))) %>%
select(region, Mean, Median) %>%
rename(" " = region) %>%
kbl(caption = "<span style = 'color:black;'><b>Distribution of Civilians Ages 16+ in the Labor Force Who are Unemployed in Tracts</b></span><br><i>Data from the 2015 - 2019 ACS</i>",
align = "l") %>%
kable_material(c("striped", "hover"),
full_width = T) %>%
row_spec(0, background = "#D9DFEE") | Mean | Median | |
|---|---|---|
| Tracts in the U.S. | 5.95% | 4.8% |
| Tracts Where Facilities are Located | 6.33% | 5.2% |
##### BY FACILITY TYPE, WHERE Y-AXIS IS THE NUMBER OF FACILITIES
# in tracts where facilities are located
prison_tract %>%
mutate(
Mean = mean(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE),
Median = median(pct_Civ_unemp_16p_ACS_15_19, na.rm = TRUE)) %>%
ggplot(aes(x = pct_Civ_unemp_16p_ACS_15_19)) +
geom_histogram(alpha = .9) +
geom_vline(aes(xintercept = Median), color = "darkred") +
geom_vline(aes(xintercept = Mean), color = "#718BCE") +
theme_bw() +
labs(y = "Number of Facilities",
x = "Percentage of Civilians Ages 16+ Unemployed",
subtitle = "Median Percentage in Red, Mean Percentage in Blue\n2015 – 2019 5-year ACS sample data",
title = 'Distribution of the Percentage of Civilians Ages 16+ in the Labor Force Who are Unemployed\nin Tracts Where Facilities are Located') +
theme(text = element_text(family = "Optima"),
plot.subtitle = element_text(face = "italic", hjust = .5),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_continuous(breaks = seq(0, 100, by = 5), limits = c(-3,105))